Heatmap: https://r-graph-gallery.com/heatmap.html
# Define APA theme
theme_apa <- function(base_size = 12, base_family = "serif") {
theme_classic(base_size = base_size, base_family = base_family) +
theme(
# Title and subtitle
plot.title = element_text(face = "bold", size = base_size * 1.2, hjust = 0.5),
plot.subtitle = element_text(size = base_size, hjust = 0.5),
# Axis titles and text
axis.title = element_text(size = base_size * 1.1),
axis.text = element_text(size = base_size),
axis.line = element_line(color = "black"),
axis.ticks = element_line(color = "black"),
# Panel and background
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.background = element_blank(),
# Legend
legend.title = element_text(size = base_size),
legend.text = element_text(size = base_size),
legend.position = "bottom",
legend.key = element_blank()
)
}
library(ggplot2)
# The mtcars dataset:
data <- as.matrix(mtcars)
# Default Heatmap
heatmap(data)
# Use 'scale' to normalize
heatmap(data, scale="column")
# No dendrogram nor reordering for neither column or row
heatmap(data, Colv = NA, Rowv = NA, scale="column") +
theme_apa()
## NULL
# 1: native palette from R
heatmap(data, scale="column", col = cm.colors(256)) + theme_apa()
## NULL
heatmap(data, scale="column", col = terrain.colors(256)) + theme_apa()
## NULL
# 2: Rcolorbrewer palette
library(RColorBrewer)
coul <- colorRampPalette(brewer.pal(8, "PiYG"))(25)
heatmap(data, scale="column", col = coul) + theme_apa()
## NULL
# Add classic arguments like main title and axis title
heatmap(data, Colv = NA, Rowv = NA, scale="column", col = coul, xlab="variable", ylab="car", main="heatmap")
# Custom x and y labels with cexRow and labRow (col respectively)
heatmap(data, scale="column", cexRow=1.5, labRow=paste("new_", rownames(data),sep=""), col= colorRampPalette(brewer.pal(8, "Blues"))(25))
# Example: grouping from the first letter:
my_group <- as.numeric(as.factor(substr(rownames(data), 1 , 1)))
colSide <- brewer.pal(9, "Set1")[my_group]
colMain <- colorRampPalette(brewer.pal(8, "Blues"))(25)
heatmap(data, Colv = NA, Rowv = NA, scale="column" , RowSideColors=colSide, col=colMain )
# Library
library(ggplot2)
# Dummy data
x <- LETTERS[1:20]
y <- paste0("var", seq(1,20))
data <- expand.grid(X=x, Y=y)
data$Z <- runif(400, 0, 5)
# Heatmap
ggplot(data, aes(X, Y, fill= Z)) +
geom_tile()
# Library
library(ggplot2)
library(hrbrthemes)
# Dummy data
x <- LETTERS[1:20]
y <- paste0("var", seq(1,20))
data <- expand.grid(X=x, Y=y)
data$Z <- runif(400, 0, 5)
# Give extreme colors:
ggplot(data, aes(X, Y, fill= Z)) +
geom_tile() +
scale_fill_gradient(low="white", high="blue") +
theme_ipsum()
# Color Brewer palette
ggplot(data, aes(X, Y, fill= Z)) +
geom_tile() +
scale_fill_distiller(palette = "RdPu") +
theme_ipsum()
# Color Brewer palette
library(viridis)
## Loading required package: viridisLite
ggplot(data, aes(X, Y, fill= Z)) +
geom_tile() +
scale_fill_viridis(discrete=FALSE) +
theme_ipsum()
## From wide input format
# Library
library(ggplot2)
library(tidyr)
library(tibble)
library(hrbrthemes)
library(dplyr)
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
# Volcano dataset
#volcano
# Heatmap
volcano %>%
# Data wrangling
as_tibble() %>%
rowid_to_column(var="X") %>%
gather(key="Y", value="Z", -1) %>%
# Change Y to numeric
mutate(Y=as.numeric(gsub("V","",Y))) %>%
# Viz
ggplot(aes(X, Y, fill= Z)) +
geom_tile() +
theme_ipsum() +
theme(legend.position="none")
## Warning: The `x` argument of `as_tibble.matrix()` must have unique column names if
## `.name_repair` is omitted as of tibble 2.0.0.
## ℹ Using compatibility `.name_repair`.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
# Library
library(ggplot2)
library(hrbrthemes)
library(plotly)
##
## Attaching package: 'plotly'
## The following object is masked from 'package:ggplot2':
##
## last_plot
## The following object is masked from 'package:stats':
##
## filter
## The following object is masked from 'package:graphics':
##
## layout
# Dummy data
x <- LETTERS[1:20]
y <- paste0("var", seq(1,20))
data <- expand.grid(X=x, Y=y)
data$Z <- runif(400, 0, 5)
# new column: text for tooltip:
data <- data %>%
mutate(text = paste0("x: ", x, "\n", "y: ", y, "\n", "Value: ",round(Z,2), "\n", "What else?"))
# classic ggplot, with text in aes
p <- ggplot(data, aes(X, Y, fill= Z, text=text)) +
geom_tile() +
theme_ipsum()
ggplotly(p, tooltip="text")
# save the widget
# library(htmlwidgets)
# saveWidget(pp, file=paste0( getwd(), "/HtmlWidget/ggplotlyHeatmap.html"))
# Load required libraries
library(ggplot2)
library(dplyr) # easier data wrangling
library(viridis) # colour blind friendly palette, works in B&W also
library(lubridate) # for easy date manipulation
##
## Attaching package: 'lubridate'
## The following objects are masked from 'package:base':
##
## date, intersect, setdiff, union
library(ggExtra) # for additional ggplot theme options
library(tidyr)
# Simulate a similar dataset (since Interpol.T is no longer available)
set.seed(123)
# Create a sample dataset
df <- data.frame(
stationid = rep("T0001", 24 * 365),
date = rep(seq.Date(from = as.Date("2023-01-01"), to = as.Date("2023-12-31"), by = "day"), each = 24),
hour = rep(0:23, 365),
temp = rnorm(24 * 365, mean = 10, sd = 5)
)
# Clean up the data
df <- df %>%
mutate(
year = year(date),
month = month(date, label = TRUE),
day = day(date)
)
# Fill missing temperature values (for demonstration)
df <- df %>%
fill(temp)
# Plotting starts here
p <- ggplot(df, aes(day, hour, fill = temp)) +
geom_tile(color = "white", size = 0.1) +
scale_fill_viridis(name = "Hrly Temps C", option = "C") +
facet_grid(year ~ month) +
scale_y_continuous(trans = "reverse", breaks = unique(df$hour)) +
scale_x_continuous(breaks = c(1, 10, 20, 31)) +
theme_minimal(base_size = 8) +
labs(title = paste("Hourly Temps - Station", unique(df$stationid)), x = "Day", y = "Hour Commencing") +
theme(
legend.position = "bottom",
plot.title = element_text(size = 14, hjust = 0),
axis.text.y = element_text(size = 6),
strip.background = element_rect(colour = "white"),
axis.ticks = element_blank(),
axis.text = element_text(size = 7),
legend.title = element_text(size = 8),
legend.text = element_text(size = 6)
) +
removeGrid() # from ggExtra
## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
# Display the plot
p
Note: https://r-graph-gallery.com/283-the-hourly-heatmap.html
packages interpol.T is removed from cran, so the code was adjusted
# Load the lattice package
library("lattice")
# Dummy data
x <- seq(1,10, length.out=20)
y <- seq(1,10, length.out=20)
data <- expand.grid(X=x, Y=y)
data$Z <- runif(400, 0, 5)
## Try it out
levelplot(Z ~ X*Y, data=data ,xlab="X",
main="")
# Load the library
library("lattice")
# Dummy data
data <- matrix(runif(100, 0, 5) , 10 , 10)
colnames(data) <- letters[c(1:10)]
rownames(data) <- paste( rep("row",10) , c(1:10) , sep=" ")
# plot it flipping the axis
levelplot(data)
#Flip and reorder axis
# Load the library
library("lattice")
# Dummy data
data <- matrix(runif(100, 0, 5) , 10 , 10)
colnames(data) <- letters[c(1:10)]
rownames(data) <- paste( rep("row",10) , c(1:10) , sep=" ")
# plot it flipping the axis
levelplot( t(data[c(nrow(data):1) , ]),
col.regions=heat.colors(100))
# Lattice package
require(lattice)
# The volcano dataset is provided, it looks like that:
#head(volcano)
# 1: native palette from R
levelplot(volcano, col.regions = terrain.colors(100)) # try cm.colors() or terrain.colors()
# 2: Rcolorbrewer palette
library(RColorBrewer)
coul <- colorRampPalette(brewer.pal(8, "PiYG"))(25)
levelplot(volcano, col.regions = coul) # try cm.colors() or terrain.colors()
# 3: Viridis
library(viridisLite)
coul <- viridis(100)
levelplot(volcano, col.regions = coul)
#levelplot(volcano, col.regions = magma(100))
#Heatmap with smoothing - LatticeExtra
# library
library(latticeExtra)
##
## Attaching package: 'latticeExtra'
## The following object is masked from 'package:ggplot2':
##
## layer
# create data
set.seed(1)
data <- data.frame(x = rnorm(100), y = rnorm(100))
data$z <- with(data, x * y + rnorm(100, sd = 1))
# showing data points on the same color scale
levelplot(z ~ x * y, data,
panel = panel.levelplot.points, cex = 1.2
) +
layer_(panel.2dsmoother(..., n = 200))